home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Various / huff.e < prev    next >
Encoding:
Text File  |  1994-10-02  |  2.5 KB  |  113 lines
  1. /* compression de huffman en E
  2.  
  3.    Tout ce qu'il fait est de vous dire quel gain si vous compressiez avec
  4.    huffman, il ne le fait pas pourle moment.
  5.  
  6.    Désolé pour les implémentations vaseuses ici et là
  7. */
  8.  
  9. MODULE 'tools/file'
  10.  
  11. PROC countfreq(adr,num,freq:PTR TO LONG)
  12.   DEF a,ch,list=NIL
  13.   FOR a:=0 TO 255 DO freq[a]:=0
  14.   FOR a:=1 TO num
  15.     ch:=adr[]++
  16.     freq[ch]:=freq[ch]+1
  17.   ENDFOR
  18.   FOR a:=0 TO 255 DO list:=Link(c([freq[a],a]),list)
  19. ENDPROC Link(c([]),list)
  20.  
  21. PROC c(l)
  22.   DEF m
  23.   IF (m:=List(ListLen(l)))=NIL THEN Raise("MEM")
  24.   ListCopy(m,l)
  25. ENDPROC m
  26.  
  27. PROC takelowest(list:PTR TO LONG)
  28.   DEF l:PTR TO LONG,lf=1000000000,lp
  29.   WHILE l:=Next(list)
  30.     IF l[]<lf
  31.       lf:=l[]
  32.       lp:=list
  33.     ENDIF
  34.     list:=l
  35.   ENDWHILE
  36.   l:=Next(lp)
  37.   Link(lp,Next(l))
  38. ENDPROC l
  39.  
  40. PROC optimize(trees)
  41.   DEF numtrees=256,lowest:PTR TO LONG,low:PTR TO LONG
  42.   WHILE numtrees>1
  43.     lowest:=takelowest(trees)
  44.     low:=takelowest(trees)
  45.     Link(trees,Link(c([lowest[]+low[],lowest,low]),Next(trees)))
  46.     DEC numtrees
  47.   ENDWHILE
  48. ENDPROC Next(trees)
  49.  
  50. PROC writetree(tree:PTR TO LONG,off=0)
  51.   DEF a
  52.   IF ListLen(tree)=2
  53.     IF off THEN FOR a:=1 TO off DO WriteF('  ')
  54.     WriteF('[char=\d,freq=\d]\n',tree[1],tree[])
  55.   ELSE
  56.     writetree(tree[1],off+1)
  57.     writetree(tree[2],off+1)
  58.   ENDIF
  59. ENDPROC
  60.  
  61. PROC computetree(tree:PTR TO LONG,res:PTR TO LONG,bit,depth=0)
  62.   DEF a,b,r:PTR TO LONG,t,ar
  63.   IF ListLen(tree)=2
  64.     r:=36*tree[1]+res
  65.     r[0]:=depth
  66.     ar:=bit
  67.     FOR a:=1 TO 8
  68.       t:=0
  69.       FOR b:=0 TO 31 DO t:=t+IF ar[]++ THEN Shl(1,b) ELSE 0
  70.       r[a]:=t
  71.     ENDFOR
  72.   ELSE
  73.     bit[depth]:=1
  74.     computetree(tree[1],res,bit,depth+1)
  75.     bit[depth]:=0
  76.     computetree(tree[2],res,bit,depth+1)
  77.   ENDIF
  78. ENDPROC
  79.  
  80. PROC writebits(b:PTR TO LONG)
  81.   DEF a,d,e
  82.   d:=b
  83.   FOR a:=0 TO 255
  84.     WriteF('b=\d\td=\d\t',b-d/36,b[]++)
  85.     FOR e:=0 TO 7 DO WriteF('\h[8]',b[]++)
  86.     WriteF('\n')
  87.   ENDFOR
  88. ENDPROC
  89.  
  90. PROC crunch(adr,num)
  91.   DEF trees, huffbits, bitarray[256]:ARRAY OF CHAR, a,freq[256]:ARRAY OF LONG,t=0
  92.   trees:=countfreq(adr,num,freq)
  93.   trees:=optimize(trees)
  94.   ->writetree(trees)
  95.   FOR a:=0 TO 255 DO bitarray[a]:=0
  96.   computetree(trees,huffbits:=NewR(36*256),bitarray)
  97.   ->writebits(huffbits)
  98.   FOR a:=0 TO 255 DO t:=t+Mul(freq[a],Long(a*36+huffbits))
  99.   WriteF('% de compressé (gain)=\d%\n',100-Div(Mul(Div(t,8),100),num))
  100. ENDPROC
  101.  
  102. PROC main() HANDLE
  103.   DEF m,l
  104.   m,l:=readfile(arg)
  105.   WriteF('Fichier compressé \s de longueur \d\n',arg,l)
  106.   crunch(m,l)
  107. EXCEPT
  108.   SELECT exception
  109.     CASE "MEM"; WriteF('Pas de Mémoire!\n')
  110.     CASE "OPEN";  WriteF('Pas de Fichier!\n')
  111.   ENDSELECT
  112. ENDPROC
  113.